home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1999 January / PC Plus Super CD No55a (PCP-147A-1-99) (Disc 1) (1998).iso / linux / developers / visualtcl / windows / vtcl / lib / balloon.tcl < prev    next >
Encoding:
Text File  |  1997-04-17  |  2.5 KB  |  80 lines
  1. ##############################################################################
  2. # $Id: balloon.tcl,v 1.3 1997/04/18 02:00:38 stewart Exp $
  3. #
  4. # balloon.tcl - procedures used by balloon help
  5. #
  6. # Copyright (C) 1996-1997 Stewart Allen
  7. #
  8. # This program is free software; you can redistribute it and/or
  9. # modify it under the terms of the GNU General Public License
  10. # as published by the Free Software Foundation; either version 2
  11. # of the License, or (at your option) any later version.
  12. #
  13. # This program is distributed in the hope that it will be useful,
  14. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. # GNU General Public License for more details.
  17. #
  18. # You should have received a copy of the GNU General Public License
  19. # along with this program; if not, write to the Free Software
  20. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ##############################################################################
  23. #
  24.  
  25. bind vTcl(balloon) <Enter> {
  26.     set vTcl(balloon,set) 0
  27.     set vTcl(balloon,first) 1
  28.     set vTcl(balloon,id) [after 500 {vTcl:balloon %W $vTcl(balloon,%W)}]
  29. }
  30.  
  31. bind vTcl(balloon) <Button> {
  32.     set vTcl(balloon,first) 0
  33.     vTcl:kill_balloon
  34. }
  35.  
  36. bind vTcl(balloon) <Leave> {
  37.     set vTcl(balloon,first) 0
  38.     vTcl:kill_balloon
  39. }
  40.  
  41. bind vTcl(balloon) <Motion> {
  42.     if {$vTcl(balloon,set) == 0} {
  43.         after cancel $vTcl(balloon,id)
  44.         set vTcl(balloon,id) [after 500 {vTcl:balloon %W $vTcl(balloon,%W)}]
  45.     }
  46. }
  47.  
  48. proc vTcl:set_balloon {target message} {
  49.     global vTcl
  50.     set vTcl(balloon,$target) $message
  51.     bindtags $target "[bindtags $target] vTcl(balloon)"
  52. }
  53.  
  54. proc vTcl:kill_balloon {} {
  55.     global vTcl
  56.     after cancel $vTcl(balloon,id)
  57.     if {[winfo exists .vTcl.balloon] == 1} {
  58.         destroy .vTcl.balloon
  59.     }
  60.     set vTcl(balloon,set) 0
  61. }
  62.  
  63. proc vTcl:balloon {target message} {
  64.     global vTcl
  65.     if {$vTcl(balloon,first) == 1 && $vTcl(pr,balloon) == 1} {
  66.         set vTcl(balloon,first) 2
  67.         set x [expr [winfo rootx $target] + ([winfo width $target]/2)]
  68.         set y [expr [winfo rooty $target] + [winfo height $target] + 4]
  69.         toplevel .vTcl.balloon -bg black
  70.         wm overrideredirect .vTcl.balloon 1
  71.         label .vTcl.balloon.l \
  72.             -text $message -relief flat \
  73.             -bg #ffffaa -fg black -padx 2 -pady 0 -anchor w
  74.         pack .vTcl.balloon.l -side left -padx 1 -pady 1
  75.         wm geometry .vTcl.balloon +${x}+${y}
  76.         set vTcl(balloon,set) 1
  77.     }
  78. }
  79.  
  80.